VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
END
Attribute VB_Name = "ODBC3"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = True
'Project Name:  Array
'Host Name:     Array.ODBC3.Punchlist
'Date:          2009-06-01
'Version:
'Author:        Joseph Weir
'
' Array writeback for Punchlist.  To add other databases.

Option Explicit

 
'---------------------------------------------------------------------------------------
' Module    : ODBC3
' DateTime  : 6/3/2009
' Purpose   : Performs SQL operations:
'---------------------------------------------------------------------------------------
'
 
' Declare object(s)
Dim m_objConnection As FSIO.Connection
 
'---------------------------------------------------------------------------------------
' Procedure : GetConnection
' DateTime  : 6/3/2009
' Purpose   : Create Import and/or Export connection
'---------------------------------------------------------------------------------------
'
Private Function GetConnection() As Boolean
 
    On Error GoTo GetConnection_Error
 
    If Not m_objConnection.IsOpen Then
        ' Show status window
        With StatusWindow
            .Alignment = fsiAlignCenter
            .BackColor = vbWhite
            .TopMost = fsiTopMost
            .Text = GetLiteral(202) ' Requires modLanguageSupport
            .Show
        End With
 
        Breathe
 
        ' Open connection
        With m_objConnection
            .Provider = "MSDASQL"
            If Windows.ComputerName = "CAN-00325000" Then
            Else
                .OpenCn DATA_SOURCE_NAME
            End If
        End With
    End If
 
    ' Set return value
    GetConnection = True
 
Release:
    ' Hide status window
    StatusWindow.Hide
    Exit Function
 
GetConnection_Error:
 
    MsgBox Err.Description, vbOKOnly + vbSystemModal, " (Array.ODBC3.Punchlist.GetConnection)"
 
    Resume Release
 
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : InstantiateConnection
' DateTime  : 6/3/2009
' Purpose   : Create an instance of the connection object
'---------------------------------------------------------------------------------------
'
Private Function InstantiateConnection() As Boolean
 
    On Error GoTo InstantiateConnection_Error
 
    ' Instantiate connection
    If m_objConnection Is Nothing Then
        With ODBC3
            .ODBCTypes = OLEDB
            Set m_objConnection = .CreateConnection
        End With
    End If
 
    ' Set return value
    InstantiateConnection = True
 
    Exit Function
 
InstantiateConnection_Error:
 
    MsgBox Err.Description & " (Array.ODBC3.Punchlist.InstantiateConnection)", vbSystemModal
 
End Function
 
'---------------------------------------------------------------------------------------
' Procedure : DestroyConnection
' DateTime  : 6/3/2009
' Purpose   : Destroy the instance of the connection object
'---------------------------------------------------------------------------------------
'
Public Sub DestroyConnection()
 
    On Error GoTo DestroyConnection_Error
 
    ' Destroy connection
    Set m_objConnection = Nothing
 
    Exit Sub
 
DestroyConnection_Error:
 
    MsgBox Err.Description & " (Array.ODBC3.Punchlist.DestroyConnection)", vbSystemModal
 
End Sub
'---------------------------------------------------------------------------------------
' Procedure : RecordExport
' DateTime  : 6/3/2009
' Purpose   : Set export data
'---------------------------------------------------------------------------------------
'
Public Sub RecordExport(ByVal objTable As FSM.Table, strFirstTrackingNumber As String)
 
    On Error GoTo RecordExport_Error
 
    Dim i As Long
    ' Declare variables for procedure
    Dim strSQL As String
    Dim objRecord As FSIX.Record
    Dim objRecordset As FSIO.Recordset
 
    If Windows.ComputerName = "CAN-00325000" Then Exit Sub
    
    ' Validate Connection object
    If Not InstantiateConnection Then Exit Sub
    ' Validate Connection state
    If Not GetConnection Then Exit Sub
 
    ' Declare variables for sql statement
    Dim strCustomerRatesCustomerRatesNetCharge As String
    Dim strMiscellaneousServiceType As String
    Dim strTrackingNumberTrackNo As String
    Dim strMiscellaneousReference As String

    For Each objRecord In objTable.Records
        ' Set return values
        With objRecord
            strCustomerRatesCustomerRatesNetCharge = .Fields("37").Value
            Select Case .Fields("1274").Value
            Case "90", "92"
                strMiscellaneousServiceType = "4"
            Case "02"
                strMiscellaneousServiceType = "2"
            Case "03", "06"
                strMiscellaneousServiceType = "3"
            Case Else
                strMiscellaneousServiceType = "1"
            End Select
            ' 2009-06-11, JFW, Only the first tracking number
            strTrackingNumberTrackNo = strFirstTrackingNumber ' .Fields("29").Value
            strMiscellaneousReference = .Fields("25").Value
        End With
 
 
        ' logfile "RecordExport", "Track " & strTrackingNumberTrackNo, "Ref " & strMiscellaneousReference
        
        ' 2009-06-11, JFW, Only 1 tracking number
'        Set objRecordset = ODBC2.OrderImport(strMiscellaneousReference)
'        If objRecordset.RecordCount > 0 Then
'            ' Keep the first tracking number
'            If objRecordset.Records(0).Fields("TrackingNumber").Value & "" <> "" Then
'                strTrackingNumberTrackNo = objRecordset.Records(0).Fields("TrackingNumber").Value & ""
'            End If
'            'strCustomerRatesCustomerRatesNetCharge = Val(strCustomerRatesCustomerRatesNetCharge) + Val(objRecordset.Records(0).Fields("FreightCharge").Value)
'        End If
        
        If IsNumeric(strMiscellaneousReference) Then
            ' Set SQL statement
            strSQL = "Update " & Chr(34) & "Orders" & Chr(34) & " Set "
            ' Not for Punchlist, maybe others
            ' strSQL = strSQL & Chr(34) & "FreightCharge" & Chr(34) & " = " & strCustomerRatesCustomerRatesNetCharge & ","
            strSQL = strSQL & Chr(34) & "ShippingMethodID" & Chr(34) & " = " & strMiscellaneousServiceType & ","
            strSQL = strSQL & Chr(34) & "Shipped" & Chr(34) & " = " & "1" & ","
            strSQL = strSQL & Chr(34) & "ShipDate" & Chr(34) & " = '" & Format(objRecord.Fields("24").Value, "yyyy-mm-dd") & "',"
            strSQL = strSQL & Chr(34) & "TrackingNumber" & Chr(34) & " =  '" & strTrackingNumberTrackNo & "'"
            strSQL = strSQL & " Where "
            strSQL = strSQL & Chr(34) & "OrderID" & Chr(34) & " = " & strMiscellaneousReference
            
            'Execute SQL statement
            ' Logfile "RecordExport", strSQL
            
            ' MsgBox "No writeback!", vbExclamation + vbSystemModal
            'If Now > #5/11/2011 10:40:00 AM# Then
                m_objConnection.Execute strSQL
            'End If
            
            For i = 1 To 1000
                DoEvents
            Next i
        End If
        
    Next objRecord
 
Release:
    Set objRecord = Nothing
 
    Exit Sub
 
RecordExport_Error:
 
    MsgBox Err.Description & " (Array.ODBC3.Punchlist.RecordExport)", vbSystemModal
 
    Resume Release
 
End Sub
'---------------------------------------------------------------------------------------
' Procedure : RecordExportDeleteShipment
' DateTime  : 6/3/2009
' Purpose   : Set export data per deletion of a shipment
'---------------------------------------------------------------------------------------
'
Public Sub RecordExportDeleteShipment(ByVal strTrackNo As String, ByVal strIndexField As String)
 
    On Error GoTo RecordExportDeleteShipment_Error
 
    ' Declare variables for procedure
    Dim strSQL As String
    Dim lngErr As Long
    Dim objTable As FSM.Table
    Dim objRecord As FSIX.Record
    Dim strIndexVal As String
 
    If Windows.ComputerName = "CAN-00325000" Then Exit Sub
    
    ' Validate Connection object
    If Not InstantiateConnection Then Exit Sub
 
    ' Validate Connection state
    If Not GetConnection Then Exit Sub
 
    'Find index value
    Set objTable = Cafe3.Databases.ExecDirect("Select " & strIndexField & " From Shipment Where 29 = '" & strTrackNo & "'")
    If objTable.Records.Count = 0 Then
        Set objTable = Cafe3.Databases.ExecDirect("Select " & strIndexField & " From Shipment Where 2044 = '" & strTrackNo & "'")
    End If
    strIndexVal = objTable.Records(0).Fields(0).Value & ""
 
    If IsNumeric(strIndexVal) Then
        ' Set SQL statement
        strSQL = "Update " & Chr(34) & "Orders" & Chr(34) & " Set "
        strSQL = strSQL & Chr(34) & "FreightCharge" & Chr(34) & " = 0,"
        ' strSQL = strSQL & Chr(34) & "ShipDate" & Chr(34) & " = '',"
        strSQL = strSQL & Chr(34) & "Shipped" & Chr(34) & " = 0,"
        strSQL = strSQL & Chr(34) & "TrackingNumber" & Chr(34) & " = ''"
        strSQL = strSQL & " Where "
        strSQL = strSQL & Chr(34) & "OrderID" & Chr(34) & " = " & strIndexVal
        
        ' Logfile "RecordExportDeleteShipment", strSQL
        
        'Execute SQL statement
        'If Now > #5/11/2011 10:40:00 AM# Then
            m_objConnection.Execute strSQL
        'End If
    End If
 
    Exit Sub
    
RecordExportDeleteShipment_Error:
 
    MsgBox Err.Description & " (Array.ODBC3.Punchlist.RecordExportDeleteShipment)", vbSystemModal
 
End Sub

